여론조사결과 등록현황 상세보기 KBS가 조사의뢰하고 (주)한국리서치가 조사기관우로 참여한 정기(정례)조사,대통령선거,정당지지도 (전국 정기(정례)조사 대통령선거 정당지지도 정치, 사회현안 등 ) 사례를 들어 데이터 추출방법을 살펴보자.
PDF → 이미지
이미지 파일
XML 페이지 이미지 메타파일
XML 페이지 텍스트 본문 https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/FILE_202109180931525561.pdf.text.xml
XML 페이지 이미지 메타파일에 포함된 XML 정보를 추후 작업이 가능한 형태로 데이터를 전처리 작업한다.
library(tidyverse)
library(xml2)
kbs_meta <- read_xml("https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/FILE_202109180931525561.pdf.xml")
kbs_meta %>%
xml_attrs("title")named character(0)
kbs_meta_nodes <- xml_find_all(kbs_meta, "//page")
kbs_meta_attributes <- kbs_meta_nodes[[1]] %>% xml_attrs(.) %>% names()
kbs_meta_df <- xml_attrs(kbs_meta_nodes) %>%
list2DF() %>%
janitor::clean_names()
row.names(kbs_meta_df) <- kbs_meta_attributes
kbs_meta_tbl <- kbs_meta_df %>%
rownames_to_column(var = "attributes") %>%
pivot_longer(cols = -attributes) %>%
pivot_wider(names_from = attributes, values_from = value) %>%
select(-name)
kbs_meta_tbl %>%
reactable::reactable()여론조사 결과 본문을 페이지 단위로 추출하자.
kbs_survey <- read_xml("https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/FILE_202109180931525561.pdf.text.xml")
## KBS 여론조사 페이지 ------
kbs_survey_page <- kbs_survey %>%
xml_children()
xml_length(kbs_survey_page) %>% length[1] 23
## 특정 페이지 : 응답자 분포표 값 --------------
xml_siblings(kbs_survey_page)[[3]] %>%
xml_children() %>%
xml_contents() %>%
as.character() [1] "1"
[2] "응답자 분포표 (1)"
[3] " Base= 전체"
[4] " 조사완료 목표할당"
[5] " 가중 값 배율"
[6] "(B/A)"
[7] "사례수 (명 )"
[8] "(A)"
[9] " 비율(%)"
[10] " 사례수 (명 )"
[11] "(B)"
[12] " 비율(%)"
[13] "▣ 전체 ▣ (1,000) 100.0 (1,000) 100.0 1.0"
[14] "성별"
[15] " "
[16] "남자 (507) 50.7 (497) 49.7 1.0"
[17] "여자 (493) 49.3 (503) 50.3 1.0"
[18] "연령 "
[19] "18-29 세 (174) 17.4 (176) 17.6 1.0"
[20] "30-39 세 (152) 15.2 (152) 15.2 1.0"
[21] "40-49 세 (182) 18.2 (187) 18.7 1.0"
[22] "50-59 세 (198) 19.8 (193) 19.3 1.0"
[23] "60-69 세 (165) 16.5 (162) 16.2 1.0"
[24] "70세이상 (129) 12.9 (130) 13.0 1.0"
[25] "거주지역 "
[26] "서울 (188) 18.8 (189) 18.9 1.0"
[27] "인천 /경기 (313) 31.3 (313) 31.3 1.0"
[28] "대전 /세종 /충청 (108) 10.8 (107) 10.7 1.0"
[29] "광주 /전라 (99) 9.9 (98) 9.8 1.0"
[30] "대구 /경북 (99) 9.9 (99) 9.9 1.0"
[31] "부산 /울산 /경남 (150) 15 (150) 15.0 1.0"
[32] "강원 /제주 (43) 4.3 (44) 4.4 1.0"
## 특정 페이지 : 응답자 분포표 좌표 --------------
table_h <- xml_siblings(kbs_survey_page)[[3]] %>%
xml_children() %>%
xml_attr("h")
table_w <- xml_siblings(kbs_survey_page)[[3]] %>%
xml_children() %>%
xml_attr("w")
table_l <- xml_siblings(kbs_survey_page)[[3]] %>%
xml_children() %>%
xml_attr("w")<https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/1.png> 같은 형식이라 KBS 8145 여론조사 결과를 이미지로 받아 낼 수가 있다. 이를 위해서 glue::glue() 함수로 다운로드할 URI 주소를 특정하고 download.file() 함수를 사용해서 로컬 디렉토리에 저장한다.
for(page in 1:23) {
page_url <- glue::glue("https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/{page}.png")
print(page_url)
download.file(url = page_url, destfile = glue::glue("data/nesdc/kbs/kbs_{page}.png"), mode = 'wb')
}다운로드 결과는 fs::dir_ls() 함수를 사용해서 확인이 가능하다.
fs::dir_ls("data/nesdc/kbs/")data/nesdc/kbs/kbs_1.png data/nesdc/kbs/kbs_10.png data/nesdc/kbs/kbs_11.png
data/nesdc/kbs/kbs_12.png data/nesdc/kbs/kbs_13.png data/nesdc/kbs/kbs_14.png
data/nesdc/kbs/kbs_15.png data/nesdc/kbs/kbs_16.png data/nesdc/kbs/kbs_17.png
data/nesdc/kbs/kbs_18.png data/nesdc/kbs/kbs_19.png data/nesdc/kbs/kbs_2.png
data/nesdc/kbs/kbs_20.png data/nesdc/kbs/kbs_21.png data/nesdc/kbs/kbs_22.png
data/nesdc/kbs/kbs_23.png data/nesdc/kbs/kbs_3.png data/nesdc/kbs/kbs_4.png
data/nesdc/kbs/kbs_5.png data/nesdc/kbs/kbs_6.png data/nesdc/kbs/kbs_7.png
data/nesdc/kbs/kbs_8.png data/nesdc/kbs/kbs_9.png
다운로드 받은 여론조사결과를 일별할 수 있도록 쭉 살펴보자.
library(tidyverse)
library(slickR)
kbs_pages <- fs::dir_ls("data/nesdc/kbs/")
kbs_tbl <- tibble(file_path = kbs_pages)
slickR(kbs_tbl$file_path, height = 600)특정 페이지에서 좌표값과 함께 해당 영역의 텍스트를 추출하는 로직을 구현해보자.
library(xml2)
library(reactable)
kbs_survey <- read_xml("https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/FILE_202109180931525561.pdf.text.xml")
## KBS 여론조사 페이지 ------
kbs_survey_page <- kbs_survey %>%
xml_children()
## 특정 페이지 : 목차 --------------
xml_siblings(kbs_survey_page)[[2]] %>%
xml_children() %>%
xml_contents() %>%
as.character() [1] " [ 목차 ]"
[2] "응답자 분포표(1) ............................................................................ 1"
[3] "응답자 분포표(2) ............................................................................ 2"
[4] "[표 1] 국정운영 평가 ........................................................................ 3"
[5] "[표 2] 대선 후보 적합도 ..................................................................... 4"
[6] "[표 3] 대선 후보 지지 강도 .................................................................. 5"
[7] "[표 4] 지지 후보가 정당 대선 후보가 안될 경우 지지 후보 ..................................... 6"
[8] "[표 5] 더불어민주당 대선 후보 적합도 ........................................................ 7"
[9] "[표 6] 국민의힘 대선 후보 적합도 ............................................................ 8"
[10] "[표 7] 대선 후보 가상 대결 (이재명 vs 윤석열 ) ................................................ 9"
[11] "[표 8] 대선 후보 가상 대결 (이낙연 vs 윤석열 ) ................................................10"
[12] "[표 9] 대선 후보 가상 대결 (이재명 vs 홍준표 ) ............................................... 11"
[13] "[표 10] 대선 후보 가상 대결 (이낙연 vs 홍준표 ) .............................................. 12"
[14] "[표 11-1] 대선 후보 호감도 - 윤석열 ........................................................ 13"
[15] "[표 11-2] 대선 후보 호감도 - 이낙연 ........................................................ 14"
[16] "[표 11-3] 대선 후보 호감도 - 이재명 ........................................................ 15"
[17] "[표 11-4] 대선 후보 호감도 - 홍준표 ........................................................ 16"
[18] "[표 12] 정당지지도 ......................................................................... 17"
[19] "[표 13] 대선 인식 (정권연장 vs 정권교체 ) .................................................... 18"
[20] "[표 14] 고발 사주 의혹 관련 인식 ........................................................... 19"
[21] "[표 15] 고발 사주 의혹 영향 ................................................................ 20"
## 특정 페이지 : 응답자 분포표 좌표 --------------
kbs_xml_tbl <-
tibble(t = xml_siblings(kbs_survey_page)[[2]] %>% xml_children() %>% xml_attr("t"), # t = top
l = xml_siblings(kbs_survey_page)[[2]] %>% xml_children() %>% xml_attr("l"), # l = left
h = xml_siblings(kbs_survey_page)[[2]] %>% xml_children() %>% xml_attr("h"), # h = height
w = xml_siblings(kbs_survey_page)[[2]] %>% xml_children() %>% xml_attr("w"), # w = width
p = xml_siblings(kbs_survey_page)[[2]] %>% xml_children() %>% xml_attr("p"), # p = paragraph(?)
content = xml_siblings(kbs_survey_page)[[2]] %>% xml_children() %>% xml_contents() %>% as.character()) %>%
mutate( t = as.numeric(t),
l = as.numeric(l),
h = as.numeric(h),
w = as.numeric(w))
kbs_xml_tbl %>%
select(-p) %>%
reactable::reactable(
columns = list(
t = colDef(width = 80),
l = colDef(width = 80),
h = colDef(width = 80),
w = colDef(width = 80)
)
)뭔가 좌표가 직관적이 아니라 이를 해결할 수 있는 방법을 찾아보자.
library(magick)
kbs_xml_img <- image_read('data/nesdc/kbs/kbs_3.png')
kbs_xml_img_box <- image_draw(kbs_xml_img)
rect(xleft = kbs_xml_tbl$l[2],
ytop = kbs_xml_tbl$t[2],
xright = kbs_xml_tbl$l[2] + kbs_xml_tbl$w[2]/10,
ybottom = kbs_xml_tbl$t[2] + abs(kbs_xml_tbl$h[2]),
border = "red", lty = "solid", lwd = 3)
dev.off()png
2
데이터 과학자 이광춘 저작
kwangchun.lee.7@gmail.com